;;; Some automatic layouts

(in-package :gwee)

(defclass cell-mixin ()
  ((cell-padding :initform 0 :initarg :padding :accessor cell-padding)
   (cell-gravity :initform :center :initarg :cell-gravity :accessor cell-gravity)))

(defclass stack-layout (view background-mixin margin-mixin cell-mixin)
  ((gravity :initform :center :initarg :gravity :accessor layout-gravity)))

(defun layout-cell-flexible-p (layout view slot)
  (eq (if (eq (funcall slot layout) 'width)
          (best-width view)
          (best-height view))
      :maximum))

(defun layout-major-flexible-p (layout view)
  (layout-cell-flexible-p layout view 'major-axis-slot))

(defun layout-minor-flexible-p (layout view)
  (layout-cell-flexible-p layout view 'minor-axis-slot))

(defun layout-major-size (layout)
  "Returns two values: the size and amount of slack that can be allocated to resizable views."
  (let ((empty-space (+ (* (cell-padding layout)
			   (1- (length (view-subviews layout))))
			(major-margin-near layout)
                        (major-margin-far layout))))
    (if (notany (lambda (x) (layout-major-flexible-p layout x)) (view-subviews layout))
	(values
	 (+ (reduce '+ (view-subviews layout) :key (lambda (x) (major-axis layout x)))
	    empty-space)
	 0)
        (values
         (major-axis layout layout)
         (- (major-axis layout layout)
            (reduce '+ (remove-if (lambda (x) (layout-major-flexible-p layout x)) (view-subviews layout))
                    :key (lambda (x) (major-axis layout x)))
            empty-space)))))

(defun layout-minor-size (layout)
  (if (notany (lambda (x) (layout-minor-flexible-p layout x)) (view-subviews layout))
      (+ (loop for i in (view-subviews layout)
	    maximize (minor-axis layout i))
	 (minor-margin-near layout)
         (minor-margin-far layout))
      (if (minor-axis-boundp layout layout)
	  (minor-axis layout layout)
	  ;; FIXME: if they're all flexible, then this will return
	  ;; 0. should we pick a bigger number?
          (+ (loop for i in (view-subviews layout)
                unless (layout-minor-flexible-p layout i)
                maximize (minor-axis layout i))
             (minor-margin-near layout)
             (minor-margin-far layout)))))

;; The stack-layout API
(defgeneric major-axis-slot (view))
(defgeneric minor-axis-slot (view))
(defgeneric major-axis (view thing))
(defgeneric minor-axis (view thing))
(defgeneric major-margin-near (view))
(defgeneric major-margin-far (view))
(defgeneric minor-margin-near (view))
(defgeneric minor-margin-far (view))
;; (defgeneric major-axis-boundp (view thing))
;; (defgeneric minor-axis-boundp (view thing))
(defgeneric major-location (view thing))
(defgeneric minor-location (view thing))
(defgeneric (setf major-axis) (value view thing))
(defgeneric (setf minor-axis) (value view thing))
(defgeneric (setf major-location) (value view thing))
(defgeneric (setf minor-location) (value view thing))

(defmethod synchronize-subview-dimensions ((layout stack-layout))
  ;; the inflexible views need their dimensions filled in
  (loop for i in (view-subviews layout)
      unless (and (layout-major-flexible-p layout i) 
                  (layout-minor-flexible-p layout i))
       do (synchronize-size i layout
                            (- (view-width layout)
                               (margin-left layout)
                               (margin-right layout))
                            (- (view-height layout)
                               (margin-top layout)
                               (margin-bottom layout))))
  (let ((num-flexible (loop for i in (view-subviews layout)
			    count (layout-major-flexible-p layout i))))
    (multiple-value-bind (majorlen slack) (layout-major-size layout)
      (loop for i = (ecase (layout-gravity layout)
                      (:top (major-margin-near layout))
                      (:bottom (- (major-axis layout layout)
                                  majorlen
                                  (- (major-margin-near layout))))
		      (:center
		       (+ (major-margin-near layout)
			  (truncate (- (major-axis layout layout)
				       majorlen)
				    2))))
	 then (+ i (major-axis layout v) (cell-padding layout))
	 for v in (view-subviews layout)
	 for cell-gravity = (if (listp (cell-gravity layout))
				(cell-gravity layout)
				(list (cell-gravity layout)))
	 then (or (cdr cell-gravity) cell-gravity)
	 do
	 (when (layout-major-flexible-p layout v)
	   ;; FIXME: we'll lose some pixels by using truncate
	   (setf (major-axis layout v) (truncate slack num-flexible)))
	 (when (layout-minor-flexible-p layout v)
	   (setf (minor-axis layout v) (- (minor-axis layout layout)
					  (minor-margin-near layout)
                                          (minor-margin-far layout))))
	 (setf (major-location layout v) i
	       (minor-location layout v)
	       (ecase (car cell-gravity)
		 (:top (minor-margin-near layout))
		 (:bottom (- (minor-axis layout layout) (minor-axis layout v) (minor-margin-far layout)))
		 (:center
                  (+ (minor-margin-near layout)		  
                     (truncate (- (minor-axis layout layout)
                                  (minor-margin-near layout) (minor-margin-far layout)
                                  (minor-axis layout v))
                               2))))))))
  (dolist (i (view-subviews layout))
    (synchronize-subview-dimensions i)))

;;; Row Layout

(defclass row-layout (stack-layout)
  ())

(defun row-sync-helper (fn subview view width height)
  (funcall fn subview view
           (- width
              (major-margin-near view)
              (major-margin-far view)
              (* (cell-padding view) (1- (length (view-subviews view)))))
           (- height
              (minor-margin-near view)
              (minor-margin-far view))))

(defmethod synchronize-width-minimum ((view row-layout) (parent view) width height)
  (+ (major-margin-near view)
     (major-margin-far view)
     (loop for i in (view-subviews view)
        sum (cell-padding view)
        unless (layout-major-flexible-p view i)
        sum (row-sync-helper 'synchronize-width i view width height))))

(defmethod synchronize-height-minimum ((view row-layout) (parent view) width height)
  (+ (minor-margin-near view)
     (minor-margin-far view)
     (loop for i in (view-subviews view)
        unless (layout-minor-flexible-p view i)
        maximize (row-sync-helper 'synchronize-height i view width height))))

(defmethod major-axis-slot ((view row-layout)) 'width)
(defmethod minor-axis-slot ((view row-layout)) 'height)

(defmethod major-axis ((view row-layout) thing)
  (view-width thing))

(defmethod minor-axis ((view row-layout) thing)
  (view-height thing))

(defmethod major-margin-near ((view row-layout))
  (margin-left view))

(defmethod major-margin-far ((view row-layout))
  (margin-right view))

(defmethod minor-margin-near ((view row-layout))
  (margin-top view))

(defmethod minor-margin-far ((view row-layout))
  (margin-bottom view))

;; (defmethod major-axis-boundp ((view row-layout) thing)
;;   (slot-boundp thing 'width))

;; (defmethod minor-axis-boundp ((view row-layout) thing)
;;   (slot-boundp thing 'height))

(defmethod major-location ((view row-layout) thing)
  (view-x thing))

(defmethod minor-location ((view row-layout) thing)
  (view-y thing))

(defmethod (setf major-axis) (value (view row-layout) thing)
  (setf (view-width thing) value))

(defmethod (setf minor-axis) (value (view row-layout) thing)
  (setf (view-height thing) value))

(defmethod (setf major-location) (value (view row-layout) thing)
  (setf (view-x thing) value))

(defmethod (setf minor-location) (value (view row-layout) thing)
  (setf (view-y thing) value))

;;; Column Layout

(defclass column-layout (stack-layout)
  ())

(defun column-sync-helper (fn subview view width height)
  (funcall fn subview view
           (- width
              (minor-margin-near view)
              (minor-margin-far view))
           (- height
              (major-margin-near view)
              (major-margin-far view)
              (* (cell-padding view) (1- (length (view-subviews view)))))))

(defmethod synchronize-width-minimum ((view column-layout) (parent view) width height)
  (+ (minor-margin-near view)
     (minor-margin-far view)
     (loop for i in (view-subviews view)
        unless (layout-minor-flexible-p view i)
        maximize (column-sync-helper 'synchronize-width i view width height))))

(defmethod synchronize-height-minimum ((view column-layout) (parent view) width height)
  (+ (major-margin-near view)
     (major-margin-far view)
     (loop for i in (view-subviews view)
        sum (cell-padding view)
        unless (layout-major-flexible-p view i)
        sum (column-sync-helper 'synchronize-height i view width height))))

(defmethod major-axis-slot ((view column-layout)) 'height)
(defmethod minor-axis-slot ((view column-layout)) 'width)

(defmethod minor-axis ((view column-layout) thing)
  (view-width thing))

(defmethod major-axis ((view column-layout) thing)
  (view-height thing))

(defmethod major-axis-boundp ((view column-layout) thing)
  (slot-boundp thing 'height))

(defmethod minor-axis-boundp ((view column-layout) thing)
  (slot-boundp thing 'width))

(defmethod minor-location ((view column-layout) thing)
  (view-x thing))

(defmethod major-location ((view column-layout) thing)
  (view-y thing))

(defmethod major-margin-near ((view column-layout))
  (margin-top view))

(defmethod major-margin-far ((view column-layout))
  (margin-bottom view))

(defmethod minor-margin-near ((view column-layout))
  (margin-left view))

(defmethod minor-margin-far ((view column-layout))
  (margin-right view))

(defmethod (setf minor-axis) (value (view column-layout) thing)
  (setf (view-width thing) value))

(defmethod (setf major-axis) (value (view column-layout) thing)
  (setf (view-height thing) value))

(defmethod (setf minor-location) (value (view column-layout) thing)
  (setf (view-x thing) value))

(defmethod (setf major-location) (value (view column-layout) thing)
  (setf (view-y thing) value))

(defstruct table-cell
  row-span column-span vertical-align horizontal-align width height) 

(defclass table-layout (view background-mixin)
  ((grid :accessor table-layout-grid)))

;; (defun sync-table-layout (table)
;;   (

;; (defun make-table (&rest layout)
;;   "A table layout is a column layout of a bunch of row layouts.

;;   `(,view1 ,view2 ,view3 ,view4
;;     (,view5 :row-span) () ()
    
;; "
